home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / STAT.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  18KB  |  663 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #define GEN
  11.  
  12. #include "hdr.h"
  13. #include "vars.h"
  14. #include "gvars.h"
  15. #include "ops.h"
  16. #include "segment.h"
  17. #include "setp.h"
  18. #include "genp.h"
  19. #include "exprp.h"
  20. #include "namp.h"
  21. #include "procp.h"
  22. #include "maincasp.h"
  23. #include "miscp.h"
  24. #include "gmiscp.h"
  25. #include "gutilp.h"
  26. #include "statp.h"
  27.  
  28. static void select_move(Node, Symbol);
  29. static Tuple sort_case(Tuple);
  30. static int tcompar(Tuple *, Tuple *);
  31. void compile_body(Node, Node, Node, int);
  32. static int jump_false_code(Symbol);
  33. static int jump_true_code(Symbol);
  34. static Symbol jump_table_get(Tuple, int);
  35. static Tuple jump_table_put(Tuple, int, Symbol);
  36.  
  37. /* Chapter 5: statements
  38.  * 5.2: Assignment statement
  39.  */
  40.  
  41. void select_assign(Node var_node, Node expr_node, Symbol type_name)
  42.                                                             /*;select_assign*/
  43. {
  44.     Symbol    var_name, expr_name;
  45.  
  46.     var_name = N_UNQ(var_node);
  47.     expr_name = N_UNQ(expr_node);
  48.     if (is_simple_type(type_name) && is_simple_name(var_node)
  49.       && !is_renaming(var_name) ) {
  50.         if ((is_simple_name(expr_node) && N_KIND(expr_node) != as_null
  51.           && !is_renaming(expr_name))
  52.           || (N_KIND(expr_node) == as_selector 
  53.           || N_KIND(expr_node) == as_index 
  54.           || N_KIND(expr_node) == as_all)) {
  55.             gen_address(expr_node);
  56.             gen_ks(I_INDIRECT_POP, kind_of(type_name), var_name);
  57.         }
  58.         else {
  59.             gen_value(expr_node);
  60.             gen_ks(I_POP, kind_of(type_name), var_name);
  61.         }
  62.     }
  63.     else {
  64.         gen_address(var_node);
  65.         select_move(expr_node, type_name);
  66.     }
  67. }
  68.  
  69. static void select_move(Node node, Symbol type_name)        /*;select_move*/
  70. {
  71.  
  72.     if (is_simple_type(type_name)) {
  73.         if ((N_KIND(node) != as_null
  74.           && is_simple_name(node) && !is_renaming(N_UNQ(node)))
  75.           || (N_KIND(node) == as_selector || N_KIND(node) == as_index
  76.           || N_KIND(node) == as_all)) {
  77.             gen_address(node);
  78.             gen_k(I_INDIRECT_MOVE, kind_of(type_name));
  79.         }
  80.         else {
  81.             gen_value(node);
  82.             gen_k(I_MOVE, kind_of(type_name));
  83.         }
  84.     }
  85.     else {
  86.         if (is_array_type(type_name)) {
  87.             gen_value(node);
  88.             gen(I_ARRAY_MOVE);
  89.         }
  90.         else {
  91.             gen_value(node);
  92.             gen_s(I_RECORD_MOVE, type_name);
  93.         }
  94.     }
  95. }
  96.  
  97. /* 5.4: Case statement */
  98. Tuple make_case_table(Node cases_node)                     /*;make_case_table*/
  99. {
  100.     /* Function : takes a set of alternatives, and produces a linear table
  101.      *            suitable for jump table, of case ranges sorted in ascending
  102.      *            order. Some optimisation is done, to merge contiguous
  103.      *            ranges and to fill missing ranges with "others" case
  104.      * Input : case_node       ::= {case_statements}
  105.      *         case_statements ::= [choice_list, body]
  106.      *         choice_list     ::= { choice }
  107.      *         choice          ::= simple_choice | range_choice
  108.      *                                           | others_choice
  109.      *      simple_choice   ::= [ value ]
  110.      *         range_choice    ::= [ subtype ]
  111.      * Output : [table, bodies, others_body]
  112.      *          table ::= [ [ lower_bound, index ] ]
  113.      *            -  an extra pair is added with a "lower_bound" one step
  114.      *               higher than necessary
  115.      *            -  "index" is an index in the tuple "bodies", and
  116.      *               index = 0 means "others"
  117.      */
  118.     Node    case_statements_node, choice_list_node, body_node, choice_node,
  119.         lbd_node, ubd_node, others_body;
  120.     Tuple    result, tup, bodies, triplets;
  121.     int        index, a1, a2, a3, b1, b2, b3, lbd_int, ubd_int;
  122.     int        empty;
  123.     Fortup    ft1, ft2;
  124.  
  125. #ifdef TRACE
  126.     if (debug_flag)
  127.         gen_trace_node("MAKE_CASE_TABLE", cases_node);
  128. #endif
  129.  
  130.     /* 1. build a set of triples [lowerbound, upperbound, index] */
  131.  
  132.     index       = 0;
  133.     bodies      = tup_new(0);
  134.     triplets    = tup_new(0);
  135.     others_body = OPT_NODE;
  136.     FORTUP(case_statements_node = (Node), N_LIST(cases_node), ft1);
  137.         choice_list_node = N_AST1(case_statements_node);
  138.         body_node = N_AST2(case_statements_node);
  139.         index += 1;
  140.         empty  = TRUE;  /* may be we have an empty branch */
  141.         FORTUP(choice_node = (Node), N_LIST(choice_list_node), ft2);
  142.             switch (N_KIND(choice_node)) {
  143.             case (as_range):
  144.                 lbd_node = N_AST1(choice_node);
  145.                 ubd_node = N_AST2(choice_node);
  146.                 lbd_int = get_ivalue_int(lbd_node);
  147.                 ubd_int = get_ivalue_int(ubd_node);
  148.                 if (lbd_int <= ubd_int) {
  149.                     tup = tup_new(3);
  150.                     tup[1] = (char *) lbd_int;
  151.                     tup[2] = (char *) ubd_int;
  152.                     tup[3] = (char *) index;
  153.                     triplets = tup_with(triplets, (char *) tup);
  154.                     empty = FALSE;
  155.                 }
  156.                 break;
  157.  
  158.             case (as_others_choice):
  159.                 others_body = body_node;
  160.                 break;
  161.  
  162.             default:
  163.                 compiler_error( "Unknown kind of choice: ");
  164.             }
  165.         ENDFORTUP(ft2);
  166.         if (empty)
  167.             index -= 1;
  168.         else
  169.             bodies  = tup_with(bodies, (char *) body_node);
  170.     ENDFORTUP(ft1);
  171.  
  172.     result = tup_new(0);
  173.  
  174.     if (tup_size(triplets) != 0) { /* We may have a completely empty case */
  175.  
  176.         /* 2. sort the set of triples, giving a tuple */
  177.  
  178.         triplets = sort_case(triplets);
  179.  
  180.         /* 3. build the case table, filling gaps and merging adjacent cases */
  181.  
  182.         tup = (Tuple) tup_fromb(triplets);
  183.         a1 = (int) tup[1]; 
  184.         a2 = (int) tup[2]; 
  185.         a3 = (int) tup[3];
  186.         while(tup_size(triplets) != 0) {
  187.             tup = (Tuple) tup_fromb(triplets);
  188.             b1 = (int) tup[1]; 
  189.             b2 = (int) tup[2]; 
  190.             b3 = (int) tup[3];
  191.             if (a2 != b1-1) {  /* gap */
  192.                 tup = tup_new(2);
  193.                 tup[1] = (char *) a1;
  194.                 tup[2] = (char *) a3;
  195.                 result = tup_with(result, (char *) tup);
  196.                 tup = tup_new(2);
  197.                 tup[1] = (char *) (a2+1);
  198.                 tup[2] = (char *) 0;
  199.                 result = tup_with(result, (char *) tup);
  200.  
  201.                 a1 = b1; 
  202.                 a2 = b2; 
  203.                 a3 = b3;
  204.             }
  205.             else if (a3 == b3)  {  /* merge */
  206.                 a2 = b2; 
  207.                 a3 = b3;
  208.             }
  209.             else {
  210.                 tup = tup_new(2);
  211.                 tup[1] = (char *) a1;
  212.                 tup[2] = (char *) a3;
  213.                 result = tup_with(result, (char *) tup);
  214.                 a1 = b1; 
  215.                 a2 = b2; 
  216.                 a3 = b3;
  217.             }
  218.         }
  219.         tup  = tup_new(2);
  220.         tup[1] = (char *) a1;
  221.         tup[2] = (char *) a3;
  222.         result = tup_with(result, (char *) tup);
  223.         tup = tup_new(2);
  224.         if (a2 != MAX_INTEGER) {
  225.             tup[1] = (char *) a2+1;
  226.             tup[2] = (char *) 0;
  227.         }
  228.         else {
  229.             tup[1] = (char *) 0; /* does not really matter */
  230.             tup[2] = (char *) a3;/* merge with the preceeding */
  231.         }
  232.         result = tup_with(result, (char *) tup);
  233.     }
  234.  
  235.     tup = tup_new(3);
  236.     tup[1] = (char *) result;
  237.     tup[2] = (char *) bodies;
  238.     tup[3] = (char *) others_body;
  239.     return tup;
  240. }
  241.  
  242. static Tuple sort_case(Tuple tuple_to_sort)                        /*;sort_case*/
  243. {
  244.     /*
  245.      * Takes a set of case triples, and returns a tuple of those triple,
  246.      * sorted by ascending lower bounds. Quick sort algorithm.
  247.      * (sorry, this is not efficient, but was very easy to write)
  248.      */
  249.  
  250.     qsort((char *) &tuple_to_sort[1], tup_size(tuple_to_sort), sizeof (char *),
  251.       (int (*)(const void *, const void *))tcompar);
  252.     return tuple_to_sort;
  253. }
  254.  
  255. static int tcompar(Tuple *ptup1, Tuple *ptup2)                    /*;tcompar*/
  256. {
  257.     Tuple    tup1, tup2;
  258.     int        n1, n2;
  259.  
  260.     tup1 = *ptup1; 
  261.     tup2 = *ptup2;
  262.     /* called from sort_case to compare two elements in the case list */
  263.     n1 = (int) tup1[1];
  264.     n2 = (int) tup2[1];
  265.     if (n1 == n2) return 0;
  266.     else if (n1 < n2) return -1;
  267.     else return 1;
  268. }
  269.  
  270. void gen_case(Tuple case_table, Tuple bodies_arg, Node others_body,int mem_unit)
  271.                                                                 /*;gen_case*/
  272. {
  273.     /* Generates the code to select the right alternative and the bodies */
  274.     int        index, lower_bound, i, n;
  275.     Node    body_node;
  276.     Symbol    end_case, jumpsym;
  277.     Tuple    jump_table, tup;
  278.     Fortup    ft1;
  279.     Tuple    bodies;
  280.  
  281.     bodies = tup_copy(bodies_arg); /* copy needed since used in tup_fromb */
  282.     end_case = new_unique_name("end_case");
  283.     gen_k(I_CASE, mem_unit);
  284.     /* The SETL jump_table map is represented as a 'tuple map' in C, with
  285.      * procedures jump_table_get() and jump_table_put() (defined below) used
  286.      * to retrieve and insert values in this map.
  287.      */
  288.     jump_table = tup_new(0);
  289.     jump_table = jump_table_put(jump_table, 0, new_unique_name("case"));
  290.     gen_ks(I_CASE_TABLE, tup_size(case_table), jump_table_get(jump_table, 0)  );
  291.     FORTUP(tup = (Tuple), case_table, ft1);
  292.         lower_bound = (int) tup[1];
  293.         index = (int) tup[2];
  294.         jumpsym = jump_table_get(jump_table, index);
  295.         if (jumpsym == (Symbol)0) { /* if no entry yet, make new one */
  296.             jumpsym = new_unique_name("case");
  297.             jump_table = jum